home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #113 (1991-01)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #113 (1991-01)(Amiga User Group Deutschland e.V.).adf / Rätsel / Linien (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-03  |  8KB  |  348 lines
  1.  
  2.  
  3.  
  4.  
  5. acbmname$="PUNKTE"
  6. REM IF FRE(1)<30000& THEN CLEAR,,30000&                         
  7. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  8. DECLARE FUNCTION xOpen&  LIBRARY
  9. DECLARE FUNCTION xRead&  LIBRARY
  10. DECLARE FUNCTION xWrite& LIBRARY
  11. DECLARE FUNCTION AllocMem&() LIBRARY
  12. LIBRARY "dos.library"
  13. LIBRARY "exec.library"
  14. LIBRARY "graphics.library"
  15.  
  16. loadError$ = ""
  17. GOSUB LoadACBM
  18. IF loadError$ <> "" THEN GOTO Mcleanup
  19.  IF foundCCRT AND ccrtDir% THEN
  20.    FOR kk = 0 TO nColors% -1
  21.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  22.       cTabWork%(kk) = cTabSave%(kk)
  23.    NEXT
  24.     FOR kk = 0 TO 80
  25.       IF ccrtDir% = 1 THEN
  26.          GOSUB Fcycle
  27.       ELSE   
  28.          GOSUB Bcycle
  29.       END IF
  30.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  31.       FOR de1 = 0 TO ccrtSecs& * 3000
  32.          FOR de2 = 0 TO ccrtMics& / 500
  33.          NEXT
  34.       NEXT
  35.    NEXT
  36.     CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  37. END IF
  38.  
  39. Mcleanup:
  40. GOTO anfang
  41. Mcleanup2:
  42. REM LIBRARY CLOSE
  43. IF loadError$ <> "" THEN PRINT loadError$
  44. END
  45. cTemp% = cTabWork%(ccrtEnd%)
  46. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  47.    cTabWork%(jj+1) = cTabWork%(jj)
  48. NEXT
  49. cTabWork%(ccrtStart%) = cTemp%
  50. RETURN
  51.  
  52. Fcycle:  '" Farbzyklus vorwärts (forward)
  53. cTemp% = cTabWork%(ccrtStart%)
  54. FOR jj = ccrtStart%+1 TO ccrtEnd%
  55.    cTabWork%(jj-1) = cTabWork%(jj)
  56. NEXT
  57. cTabWork%(ccrtEnd%) = cTemp%
  58. RETURN
  59.  
  60.  
  61. LoadACBM:
  62. '" - Folgende Variablen müssen 
  63. '" - initialisiert sein:
  64. REM -    ACBMname$ (ACBM-Dateiname)
  65.  
  66. REM - Variablen initialisieren
  67. f$ = acbmname$
  68. fHandle& = 0
  69. mybuf& = 0
  70. foundBMHD = 0
  71. foundCMAP = 0
  72. foundCAMG = 0
  73. foundCCRT = 0
  74. foundABIT = 0
  75.  
  76. REM - aus include/libraries/dos.h
  77. REM - MODE_NEWFILE = 1006 
  78. REM - MODE_OLDFILE = 1005
  79.  
  80. filename$ = f$ + CHR$(0)
  81. fHandle& = xOpen&(SADD(filename$),1005)
  82. IF fHandle& = 0 THEN
  83.    loadError$ = "Eingabedatei nicht gefunden/lesbar."
  84.    GOTO Lcleanup
  85. END IF
  86.  
  87.  
  88. REM - Pufferspeicherplatz reservieren
  89. ClearPublic& = 65537
  90. mybufsize& = 360
  91. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  92. IF mybuf& = 0 THEN
  93.    loadError$ = "Pufferspeicherplatz nicht verfügbar."
  94.    GOTO Lcleanup
  95. END IF
  96.  
  97. inbuf& = mybuf&
  98. cbuf& = mybuf& + 120
  99. ctab& = mybuf& + 240
  100.  
  101.  
  102. REM - Eingabe sollte lauten  FORMnnnnACBM
  103. rLen& = xRead&(fHandle&,inbuf&,12)
  104. tt$ = ""
  105. FOR kk = 8 TO 11
  106.    tt% = PEEK(inbuf& + kk)
  107.    tt$ = tt$ + CHR$(tt%)
  108. NEXT
  109.  
  110. IF tt$ <> "ACBM" THEN 
  111.    loadError$ = "Keine ACBM-Grafikdatei."
  112.    GOTO Lcleanup
  113. END IF
  114.  
  115. REM - ACBM-Datei Chunk-weise lesen
  116.  
  117. ChunkLoop:
  118. REM - Chunk-Name/Länge ermitteln
  119.  rLen& = xRead&(fHandle&,inbuf&,8)
  120.  icLen& = PEEKL(inbuf& + 4)
  121.  tt$ = ""
  122.  FOR kk = 0 TO 3
  123.     tt% = PEEK(inbuf& + kk)
  124.     tt$ = tt$ + CHR$(tt%)
  125.  NEXT   
  126.     
  127. IF tt$ = "BMHD" THEN  'BitMap-Header 
  128.    foundBMHD = 1
  129.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  130.    iWidth%  = PEEKW(inbuf&)
  131.    iHeight% = PEEKW(inbuf& + 2)
  132.    iDepth%  = PEEK(inbuf& + 8)  
  133.    iCompr%  = PEEK(inbuf& + 10)
  134.    scrWidth%  = PEEKW(inbuf& + 16)
  135.    scrHeight% = PEEKW(inbuf& + 18)
  136.  
  137.    iRowBytes% = iWidth% /8
  138.    scrRowBytes% = scrWidth% / 8
  139.    nColors%  = 2^(iDepth%)
  140.  
  141.    '" - Genug Platz für Videospeicher ?
  142.    AvailRam& = FRE(-1)
  143.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  144.    IF AvailRam& < NeededRam& THEN
  145.       loadError$ = "Speicherplatz reicht nicht aus."
  146.       GOTO Lcleanup
  147.    END IF
  148.  
  149.    kk = 1
  150.    IF scrWidth% > 320 THEN kk = kk + 1
  151.    IF scrHeight% > 200  THEN kk = kk + 2
  152.    SCREEN 2,scrWidth%,scrHeight%,5,1
  153.    WINDOW 2,"",,0,2
  154.    CALL freesprite (0)
  155.    REM - Adressen von Screen-Structures ermitteln
  156.    GOSUB GetScrAddrs
  157.  
  158.    REM - Schirm während Ladevorgang dunkel
  159.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  160.  
  161.  
  162. ELSEIF tt$ = "CMAP" THEN  'Farbpalette
  163.    foundCMAP = 1
  164.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  165.  
  166.    REM - Farbpalette aufbauen
  167.    FOR kk = 0 TO nColors% - 1
  168.       red% = PEEK(cbuf&+(kk*3))
  169.       gre% = PEEK(cbuf&+(kk*3)+1)
  170.       blu% = PEEK(cbuf&+(kk*3)+2)
  171.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  172.       POKEW(ctab&+(2*kk)),regTemp%
  173.    NEXT
  174.  
  175.  
  176. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  177.    foundCAMG = 1
  178.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  179.    camgModes& = PEEKL(inbuf&)
  180.  
  181.  
  182. ELSEIF tt$ = "CCRT" THEN 'Graphicraft-Farbzyklus-Daten
  183.    foundCCRT = 1
  184.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  185.    ccrtDir%    = PEEKW(inbuf&)
  186.    ccrtStart%  = PEEK(inbuf& + 2)
  187.    ccrtEnd%    = PEEK(inbuf& + 3)
  188.    ccrtSecs&   = PEEKL(inbuf& + 4)
  189.    ccrtMics&   = PEEKL(inbuf& + 8)
  190.  
  191.  
  192. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  193.    foundABIT = 1
  194.  
  195.    '" - Hier werden nur volle BitMaps verarbeitet, keine 
  196.    '" - Ausschnitte wie z.B. Pinsel (Brushes).
  197.    '" - Sehr schnell, liest ganze BitPlanes.
  198.    plSize& = (scrWidth%/8) * scrHeight%
  199.    FOR pp = 0 TO iDepth% -1
  200.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  201.    NEXT
  202.  
  203.  
  204. ELSE 
  205.    REM - unbekannten Chunk-Typ lesen  
  206.    FOR kk = 1 TO icLen&
  207.       rLen& = xRead&(fHandle&,inbuf&,1)
  208.    NEXT
  209.    '" - Wenn Länge ungerade, noch 1 Byte lesen
  210.    IF (icLen& OR 1) = icLen& THEN 
  211.       rLen& = xRead&(fHandle&,inbuf&,1)
  212.    END IF
  213.       
  214. END IF
  215.  
  216.  
  217. REM - Fertig, wenn alle Chunks gelesen
  218. IF foundBMHD AND foundCMAP AND foundABIT THEN
  219.    GOTO GoodLoad
  220. END IF
  221.  
  222. REM - Lesen ok, nächsten Chunk lesen
  223. IF rLen& > 0 THEN GOTO ChunkLoop
  224.  
  225. IF rLen& < 0 THEN  ' Lesefehler
  226.    loadError$ = "Lesefehler."
  227.    GOTO Lcleanup
  228. END IF   
  229.  
  230. REM - rLen& = 0  heißt EOF (Dateiende)
  231. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  232.    loadError$ = "Wichtige IFF-Chunks nicht gefunden."
  233.    GOTO Lcleanup
  234. END IF
  235.  
  236.  
  237. GoodLoad:
  238. loadError$ =""
  239.  
  240. REM  Farbpalette
  241. IF foundCMAP THEN 
  242.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  243. END IF
  244.  
  245. Lcleanup:
  246. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  247. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  248.  
  249. RETURN
  250.  
  251.  
  252. GetScrAddrs:
  253. REM - Adressen von Screen-Structures ermitteln
  254.    sWindow&   = WINDOW(7)
  255.    sScreen&   = PEEKL(sWindow& + 46)
  256.    sViewPort& = sScreen& + 44
  257.    sRastPort& = sScreen& + 84
  258.    sColorMap& = PEEKL(sViewPort& + 4)
  259.    colorTab&  = PEEKL(sColorMap& + 4)
  260.    sBitMap&   = PEEKL(sRastPort& + 4)
  261.  
  262.    REM - Screen-Parameter ermitteln
  263.    scrWidth%  = PEEKW(sScreen& + 12)
  264.    scrHeight% = PEEKW(sScreen& + 14)
  265.    scrDepth%  = PEEK(sBitMap& + 5)
  266.    nColors%   = 2^scrDepth%
  267.  
  268.    REM - Adressen der BitPlanes ermitteln
  269.    FOR kk = 0 TO scrDepth% - 1
  270.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  271.    NEXT
  272. RETURN
  273. anfang:
  274.    
  275.    ']]]]]]]]]]]]]]]]]]]]]]]]]]]]
  276.    b=0
  277.    LINE (30,190)-(100,215),4,bf
  278.    LINE (29,189)-(101,216),2,b
  279.    COLOR 7,4:LOCATE 26,5:PRINT "ZEICHNEN"
  280.  maus:
  281.    WHILE 1
  282.    v= MOUSE(0)
  283.    IF MOUSE(0) = 0 THEN WEND
  284.    CALL maus(x,y)
  285.    IF x>30 AND x<100 AND y>180 AND y<210 THEN GOTO zeichnen
  286.    IF x>250 AND x<305 AND y>30 AND y<50 THEN GOTO ende
  287.    
  288.    SUB maus (x,y) STATIC
  289.    x = MOUSE(1)
  290.    y = MOUSE(2)
  291.    END SUB
  292.    GOTO maus  
  293. zeichnen:  
  294.   WINDOW 2  
  295.   a=MOUSE(0):x=MOUSE(1):y=MOUSE(2) 
  296.   WHILE MOUSE(0)<>0
  297.   LINE(x,y)-(MOUSE(1),MOUSE(2)),b
  298.   IF x>30 AND x<100 AND y>180 AND y<210 THEN GOTO zeichnen
  299.   IF x>250 AND x<305 AND y>30 AND y<50 THEN GOTO ende
  300.   IF x>30 AND x<100 AND y>30 AND y<50 THEN GOTO aufloesung
  301.   IF x>240 AND x<310 AND y>180 AND y<210 THEN GOTO neu
  302.   x=MOUSE(1):y=MOUSE(2)
  303.   WEND
  304.   GOTO zeichnen   
  305.   END
  306. aufloesung:
  307.    a=0:
  308.    LINE (90,73)-(165,116),a
  309.    LINE (90,109)-(165,152),a
  310.    LINE (90,139)-(165,185),a 
  311.    LINE (165,152)-(247,111),a
  312.    LINE (165,185)-(247,141),a
  313.    LINE (165,116)-(247,76),a
  314.    LINE (165,116)-(165,217),a   
  315.    LINE (116,86)-(198,47),a
  316.    LINE (140,101)-(220,60),a
  317.    GOTO anfang
  318. neu:
  319.    COLOR 2,6
  320.    AREA (91,73):AREA (91,166):AREA (165,217):AREAFILL
  321.    AREA (91,73):AREA (165,217):AREA (247,76):AREAFILL
  322.    AREA (165,217):AREA (247,76):AREA (247,171):AREAFILL
  323.    AREA (91,73):AREA (247,76):AREA (175,33):AREAFILL
  324.    CIRCLE (190,62),6,5,,,1:PAINT (190,62),5
  325.    CIRCLE (170,100),6,5,,,1:PAINT (170,100),5
  326.    CIRCLE (118,72),6,5,,,1:PAINT (118,72),5
  327.    CIRCLE (150,125),6,5,,,1:PAINT (150,125),5
  328.    CIRCLE (149,189),6,5,,,1:PAINT (149,189),5
  329.    CIRCLE (101,131),6,5,,,1:PAINT (101,131),5 
  330.    CIRCLE (230,164),6,5,,,1:PAINT (230,164),5
  331.    CIRCLE (230,100),6,5,,,1:PAINT (230,100),5
  332.    CIRCLE (181,160),6,5,,,1:PAINT (181,160),5
  333.    GOTO anfang
  334.    END
  335. ende:
  336.    WINDOW CLOSE 1
  337.    SCREEN CLOSE 1
  338.    SYSTEM
  339.    END
  340.    
  341. '**********************************************************************
  342. ' Detlef Kornatz
  343. ' Feuerbachstraße 6
  344. ' D-4300 ESSEN 1
  345. '***********************************************************************
  346.  
  347.  
  348.